home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
login.fr_
/
login.fr
Wrap
Text File
|
1995-07-19
|
23KB
|
757 lines
VERSION 4.00
Begin VB.Form frmODBC
BackColor = &H00C0C0C0&
Caption = "Update Visual Basic ODBC Settings"
ClientHeight = 5610
ClientLeft = 1665
ClientTop = 1980
ClientWidth = 7920
Height = 6105
Left = 1560
LinkTopic = "Form1"
ScaleHeight = 5610
ScaleWidth = 7920
Top = 1590
Width = 8130
Begin VB.CommandButton cmdQuit
Caption = "Quit"
Height = 495
Left = 6360
TabIndex = 59
Top = 1320
Width = 1215
End
Begin VB.CommandButton cmdUpdate
Caption = "Update"
Height = 495
Left = 6360
TabIndex = 58
Top = 600
Width = 1215
End
Begin VB.TextBox txtNew
Height = 285
Index = 13
Left = 3480
TabIndex = 56
Top = 5160
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 13
Left = 2160
TabIndex = 55
TabStop = 0 'False
Top = 5160
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 12
Left = 3480
TabIndex = 52
Top = 4800
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 12
Left = 2160
TabIndex = 51
TabStop = 0 'False
Top = 4800
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 11
Left = 3480
TabIndex = 48
Top = 4440
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 11
Left = 2160
TabIndex = 47
TabStop = 0 'False
Top = 4440
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 10
Left = 3480
TabIndex = 44
Top = 4080
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 10
Left = 2160
TabIndex = 43
TabStop = 0 'False
Top = 4080
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 9
Left = 3480
TabIndex = 40
Top = 3720
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 9
Left = 2160
TabIndex = 39
TabStop = 0 'False
Top = 3720
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 8
Left = 3480
TabIndex = 36
Top = 3360
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 8
Left = 2160
TabIndex = 35
TabStop = 0 'False
Top = 3360
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 7
Left = 3480
TabIndex = 32
Top = 3000
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 7
Left = 2160
TabIndex = 31
TabStop = 0 'False
Top = 3000
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 6
Left = 3480
TabIndex = 28
Top = 2640
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 6
Left = 2160
TabIndex = 27
TabStop = 0 'False
Top = 2640
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 5
Left = 3480
TabIndex = 24
Top = 2280
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 5
Left = 2160
TabIndex = 23
TabStop = 0 'False
Top = 2280
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 4
Left = 3480
TabIndex = 20
Top = 1920
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 4
Left = 2160
TabIndex = 19
TabStop = 0 'False
Top = 1920
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 3
Left = 3480
TabIndex = 16
Top = 1560
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 3
Left = 2160
TabIndex = 15
TabStop = 0 'False
Top = 1560
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 2
Left = 3480
TabIndex = 12
Top = 1200
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 2
Left = 2160
TabIndex = 11
TabStop = 0 'False
Top = 1200
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 1
Left = 3480
TabIndex = 8
Top = 840
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 1
Left = 2160
TabIndex = 7
TabStop = 0 'False
Top = 840
Width = 1000
End
Begin VB.TextBox txtNew
Height = 285
Index = 0
Left = 3480
TabIndex = 4
Top = 480
Width = 1000
End
Begin VB.TextBox txtCurrent
BackColor = &H00C0C0C0&
Height = 285
Index = 0
Left = 2160
TabIndex = 3
TabStop = 0 'False
Top = 480
Width = 1000
End
Begin MSComDlg.CommonDialog cdOpen
Left = 6360
Top = 0
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
DefaultExt = "ini"
DialogTitle = "Select INI file to Modify"
FileName = "*.ini"
Filter = "INI Files (*.ini)"
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 13
Left = 4800
TabIndex = 57
Top = 5160
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 13
Left = 240
TabIndex = 54
Top = 5160
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 12
Left = 4800
TabIndex = 53
Top = 4800
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 12
Left = 240
TabIndex = 50
Top = 4800
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 11
Left = 4800
TabIndex = 49
Top = 4440
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 11
Left = 240
TabIndex = 46
Top = 4440
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 10
Left = 4800
TabIndex = 45
Top = 4080
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 10
Left = 240
TabIndex = 42
Top = 4080
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 9
Left = 4800
TabIndex = 41
Top = 3720
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 9
Left = 240
TabIndex = 38
Top = 3720
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 8
Left = 4800
TabIndex = 37
Top = 3360
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 8
Left = 240
TabIndex = 34
Top = 3360
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 7
Left = 4800
TabIndex = 33
Top = 3000
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 7
Left = 240
TabIndex = 30
Top = 3000
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 6
Left = 4800
TabIndex = 29
Top = 2640
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 6
Left = 240
TabIndex = 26
Top = 2640
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 5
Left = 4800
TabIndex = 25
Top = 2280
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 5
Left = 240
TabIndex = 22
Top = 2280
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 4
Left = 4800
TabIndex = 21
Top = 1920
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 4
Left = 240
TabIndex = 18
Top = 1920
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 3
Left = 4800
TabIndex = 17
Top = 1560
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 3
Left = 240
TabIndex = 14
Top = 1560
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 2
Left = 4800
TabIndex = 13
Top = 1200
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 2
Left = 240
TabIndex = 10
Top = 1200
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 1
Left = 4800
TabIndex = 9
Top = 840
Width = 1200
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 1
Left = 240
TabIndex = 6
Top = 840
Width = 1700
End
Begin VB.Label lblUnits
BackColor = &H00C0C0C0&
Height = 255
Index = 0
Left = 4800
TabIndex = 5
Top = 480
Width = 1200
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "New"
Height = 255
Left = 3480
TabIndex = 2
Top = 120
Width = 1000
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "Current"
Height = 255
Left = 2160
TabIndex = 1
Top = 120
Width = 1005
End
Begin VB.Label lblSetting
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
Height = 255
Index = 0
Left = 240
TabIndex = 0
Top = 480
Width = 1700
End
End
Attribute VB_Name = "frmODBC"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim iniName As String
Dim arrayMax As Integer
Private Sub cmdQuit_Click()
End
End Sub
Private Sub cmdUpdate_Click()
Dim i As Integer
Dim result As Integer
Dim counter As Integer
Dim setting As String
result = MsgBox("Are you sure you want to write changes to " & iniName & "?", 4, "WARNING!")
If result = 7 Then
End
End If
'Run through the control array, checking to see if there
'have been any entries that should be entered into the INI
'file.
counter = 0
For i = 0 To arrayMax
If Len(txtNew(i).TEXT) Then
setting = Trim(txtNew(i).TEXT)
result = WritePrivateProfileString("ODBC", lblSetting(i).Caption, ByVal setting, iniName)
counter = counter + 1
End If
Next
If counter Then
'Reload the current settings so that the current
'column reflects the actual, updated settings in
'the file.
loadSettings
Else
'Nothing was entered to change
MsgBox "No changes were entered, so nothing changed."
End If
End Sub
Private Sub Form_Load()
Dim result As Integer
Dim winDirName As String * 256
Dim lenDirName As Integer
arrayMax = 13
result = MsgBox("Running this program will cause the default settings to be written to VB.INI. Proceed?", 4, "WARNING!")
If result = 7 Then
End
End If
'Get the name of the Windows directory
lenDirName = GetWindowsDirectory(winDirName, Len(winDirName))
If lenDirName = 0 Then
MsgBox "Error occurred getting Windows directory name. Exiting procedure."
Unload Me
End If
'Need to get the file to use: VB.INI or the <app>.INI
cdOpen.InitDir = Left(winDirName, lenDirName)
cdOpen.CancelError = True
On Error GoTo cdCancelError
cdOpen.ShowOpen
On Error GoTo 0
iniName = cdOpen.filename
loadSettings
ExitSubroutine:
Exit Sub
cdCancelError:
If Err.Number = cdlCancel Then
'User pressed Cancel, so quit the program
Unload Me
Else
Error Err.Number
Resume ExitSubroutine
End If
End Sub
Sub loadSettings()
'Load the control array
lblSetting(0).Caption = "TraceSQLMode"
txtCurrent(0).TEXT = GetCurrentInt(lblSetting(0).Caption, 0)
lblUnits(0).Caption = "True/False"
txtNew(0).TEXT = ""
lblSetting(1).Caption = "TraceODBCAPI"
txtCurrent(1).TEXT = GetCurrentInt(lblSetting(1).Caption, 0)
lblUnits(1).Caption = "True/False"
txtNew(1).TEXT = ""
lblSetting(2).Caption = "DisableAsync"
txtCurrent(2).TEXT = GetCurrentInt(lblSetting(2).Caption, 0)
lblUnits(2).Caption = "True/False"
txtNew(2).TEXT = ""
lblSetting(3).Caption = "LoginTimeout"
txtCurrent(3).TEXT = GetCurrentInt(lblSetting(3).Caption, 20)
lblUnits(3).Caption = "Seconds"
txtNew(3).TEXT = ""
lblSetting(4).Caption = "QueryTimeout"
txtCurrent(4).TEXT = GetCurrentInt(lblSetting(4).Caption, 60)
lblUnits(4).Caption = "Seconds"
txtNew(4).TEXT = ""
lblSetting(5).Caption = "ConnectionTimeout"
txtCurrent(5).TEXT = GetCurrentInt(lblSetting(5).Caption, 600)
lblUnits(5).Caption = "Seconds"
txtNew(5).TEXT = ""
lblSetting(6).Caption = "AsyncRetryInterval"
txtCurrent(6).TEXT = GetCurrentInt(lblSetting(6).Caption, 500)
lblUnits(6).Caption = "Seconds"
txtNew(6).TEXT = ""
lblSetting(7).Caption = "AttachCaseSensitive"
txtCurrent(7).TEXT = GetCurrentInt(lblSetting(7).Caption, 0)
lblUnits(7).Caption = "True/False"
txtNew(7).TEXT = ""
lblSetting(8).Caption = "SnapshotOnly"
txtCurrent(8).TEXT = GetCurrentInt(lblSetting(8).Caption, 0)
lblUnits(8).Caption = "True/False"
txtNew(8).TEXT = ""
lblSetting(9).Caption = "TryJetAuth"
txtCurrent(9).TEXT = GetCurrentInt(lblSetting(9).Caption, 1)
lblUnits(9).Caption = "Yes/No"
txtNew(9).TEXT = ""
lblSetting(10).Caption = "PreparedInsert"
txtCurrent(10).TEXT = GetCurrentInt(lblSetting(10).Caption, 0)
lblUnits(10).Caption = "True/False"
txtNew(10).TEXT = ""
lblSetting(11).Caption = "PreparedUpdate"
txtCurrent(11).TEXT = GetCurrentInt(lblSetting(11).Caption, 0)
lblUnits(11).Caption = "Yes/No"
txtNew(11).TEXT = ""
lblSetting(12).Caption = "FastRequery"
txtCurrent(12).TEXT = GetCurrentInt(lblSetting(12).Caption, 0)
lblUnits(12).Caption = "Yes/No"
txtNew(12).TEXT = ""
lblSetting(13).Caption = "AttachableObjects"
txtCurrent(13).TEXT = GetCurrentStr(lblSetting(13).Caption, "'TABLE', 'VIEW', 'SYSTEM TABLE', 'ALIAS', 'SYNONYM'")
lblUnits(13).Caption = ""
txtNew(13).TEXT = ""
End Sub
Function GetCurrentInt(lineName As String, defValue As Integer) As Integer
GetCurrentInt = GetPrivateProfileInt("ODBC", lineName, defValue, iniName)
End Function
Function GetCurrentStr(lineName As String, defValue As String) As String
Dim retStr As String * 256
Dim result As Integer
result = GetPrivateProfileString("ODBC", lineName, defValue, retStr, Len(retStr), iniName)
GetCurrentStr = retStr
End Function
